home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 098 / brooks.arc / PDWORD.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1987-11-27  |  3.7 KB  |  123 lines
  1.  
  2.     
  3.     
  4.     
  5. (defun C:QTSW ();       Toggles QTEXTMODE
  6. ; by Roger S. Brooks, 4880 Galley Rd. #228, Colorado Springs, CO 80915
  7.     (if (= 0 (getvar "QTEXTMODE"))
  8.         (command "QTEXT" "ON")
  9.         (command "QTEXT" "OFF")
  10.     )
  11. )
  12. ;
  13. (defun C:BOX ();        Draws a box on current layer
  14. ; by Roger S. Brooks, 4880 Galley Rd. #228, Colorado Springs, CO 80915
  15. ; three specification modes are available:
  16. ;       <default>    two diagonally opposite corners
  17. ;       Side            center of one side, width and center of opposite side
  18.     (setvar "CMDECHO" 0)
  19.     (if (setq pt1 (getpoint "Side/<First corner>: "))
  20.     (progn
  21.         (setq pt3 (getpoint "Second corner: "))
  22.         (setq pt2 (list (car pt1) (cadr pt3)))
  23.         (setq pt4 (list (car pt3) (cadr pt1)))
  24.     )
  25.     (progn
  26.         (setq pt0 (getpoint "Center of side: "))
  27.         (setq pt1 (getpoint "Center of opposite side: "))
  28.         (setq da (- (angle pt0 pt1) (/ pi 2)))
  29.         (setq dw (/ (getdist "Width of box: ") 2))
  30.         (setq pt2 (polar pt1 (- da) dw))
  31.         (setq pt3 (polar pt1 da dw))
  32.         (setq pt1 (polar pt0 (- da) dw))
  33.         (setq pt4 (polar pt0 da dw))
  34.     )
  35.     )
  36.     (command "PLINE" pt1 pt2 pt3 pt4 "C")
  37.     (quote Command: )
  38. )
  39. ;
  40. (defun C:CBOX ()
  41. ; draws a box on current layer given center and one corner
  42. ; by Roger S. Brooks, 4880 Galley Rd. #228, Colorado Springs, CO 80915
  43.     (setvar "CMDECHO" 0)
  44.     (setq pt0 (getpoint "Center of box: "))
  45.     (setq pt1 (getpoint "Enter corner: "))
  46.     (setq x3 (- (* 2 (car pt0)) (car pt1)))
  47.     (setq y3 (- (* 2 (cadr pt0)) (cadr pt1)))
  48.     (setq pt2 (list (car pt1) y3))
  49.     (setq pt3 (list x3 y3))
  50.     (setq pt4 (list x3 (cadr pt1)))
  51.     (command "PLINE" pt1 pt2 pt3 pt4 "C")
  52.     (quote Command: )
  53. )
  54.     
  55.     
  56.     
  57.     
  58. (defun C:BUBBLE ();    draws a numbered bubble with leader on layer 0
  59. ; by Roger S. Brooks, 4880 Galley Rd. #228, Colorado Springs, CO 80915
  60.     (setvar "CMDECHO" 0)
  61.     (command "LAYER" "S" "0")
  62.     (setq dx (setq delta (getvar "TEXTSIZE")))
  63.     (setq pt0 (getpoint "Object/<Start point>: "))
  64.     (if pt0
  65.     (progn
  66.         (setq pt1 (getpoint "Second point: "))
  67.         (setq dangle (angtos (angle pt0 pt1) 0 1))
  68.         (command "SHAPE" "SQUIGGLE" pt0 delta dangle)
  69.     )
  70.     (progn
  71.         (setq pt0 (getpoint "Boundary point: "))
  72.         (setq pt1 (getpoint "Second point: "))
  73.     )
  74.     )
  75.     (command "DIM")
  76.     (command "LEADER" pt0 pt1 "" "")
  77.     (command)
  78.     (setq x2 (car pt1))
  79.     (setq y2 (cadr pt1))
  80.     (if (>= (car pt0) x2) (setq dx (- dx)))
  81.     (if (/= (cadr pt0) y2) (setq dx (* 2 dx)))
  82.     (setq x2 (+ x2 dx))
  83.     (setq pt2 (list x2 y2))
  84.     (command "CIRCLE" pt2 delta)
  85.     (setq txt (getstring "Bubble number: "))
  86.     (setq pt2 (list x2 (- y2 (/ delta 2))))
  87.     (command "TEXT" "C" pt2 delta 0 txt)
  88.     (quote Command: )
  89. )
  90. ;
  91. (defun C:NOTES ();
  92. ; by Roger S. Brooks, 4880 Galley Rd. #228, Colorado Springs, CO 80915
  93.     (setvar "CMDECHO" 0)
  94.     (setq filename (getstring "Text file: "))
  95.     (setq handle (open filename "r"))
  96.     (if handle
  97.     (progn
  98.         (setq mode (getvar "LUNITS"))
  99.         (setq prec (getvar "LUPREC"))
  100.         (setq size (rtos (getvar "TEXTSIZE") mode prec))
  101.         (setq str (strcat "Height <" size ">: "))
  102.         (setq pt (getpoint "Upper left corner: "))
  103.         (setq ht (getreal str))
  104.         (if (not ht) (setq ht (getvar "TEXTSIZE")))
  105.         (setq pt (list (car pt) (- (cadr pt) ht)))
  106.         (if (setq str (read-line handle))
  107.         (progn
  108.             (setq line (/ ht 0.6))
  109.             (command "TEXT" pt ht 0 str)
  110.             (while (setq str (read-line handle))
  111.             (setq pt (list (car pt) (- (cadr pt) line)))
  112.             (command "TEXT" pt ht 0 str)
  113.             )
  114.         )
  115.         (write-line "File is empty.")
  116.         )
  117.         (close handle)
  118.     )
  119.     (write-line "No such file.")
  120.     )
  121.     (quote Command: )
  122. )
  123.